import Data.Char (isDigit)
import Data.List (transpose, isPrefixOf)
import qualified Data.Set as Set

splitAll :: Eq a => [a] -> [a] -> [[a]]
splitAll _ [] = []
splitAll delims xs = 
    token : splitAll delims rest
    where
        isDelimiter = (`elem` delims)
        token       = takeWhile (not . isDelimiter) xs
        rest        = dropWhile isDelimiter $ dropWhile (not . isDelimiter) xs

type Value = Int
type Ticket = [Value]
type Range = (Value, Value)

type FeildName = String
data Feild = Feild FeildName (Range, Range) deriving (Show)

type Document = ([Feild], Ticket, [Ticket])

parseTicket :: String -> Ticket
parseTicket = map read . splitAll "," 

-- 43-322
parseRange :: String -> Range
parseRange string = (low, heigh)
    where
        low = read . takeWhile isDigit $ string
        heigh = read . tail . dropWhile isDigit $ string

-- departure location: 42-322 or 347-954
parseFeild :: String -> Feild
parseFeild string = Feild name (range1, range2)
    where
        name = takeWhile (/=':') string
        rangeStrings = splitAll " or " 
                     . drop 2 
                     . dropWhile (/=':') $ string

        range1 = parseRange (rangeStrings !! 0)
        range2 = parseRange (rangeStrings !! 1)

parseInput :: String -> Document
parseInput input = (feilds, ticket, tickets)
    where
        tokens = splitAll [""] . lines $ input

        feilds = map parseFeild (tokens !! 0)
        ticket = parseTicket . last $ (tokens !! 1)
        tickets = map parseTicket . tail $ (tokens !! 2)

-------------------------------------------------------------------

isInRange :: Value -> Range -> Bool
isInRange value (low, heigh) = (value >= low) && (value <= heigh)

isValidForFeild :: Value -> Feild -> Bool
isValidForFeild value (Feild _ (range1,range2)) = (isInRange value range1) || (isInRange value range2)

isValidForFeilds :: Value -> [Feild] -> Bool
isValidForFeilds value = any (isValidForFeild value)

isTicketValid :: [Feild] -> Ticket -> Bool
isTicketValid feilds ticket = all (\v -> isValidForFeilds v feilds) ticket

filterInvalidValue :: Document -> Document
filterInvalidValue (feilds, ticket, tickets) = (feilds, ticket, filteredTickets)
    where
        filteredTickets = filter (isTicketValid feilds) tickets

-------------------------------------------------------------------

isAllValidForFeild :: [Value] -> Feild -> Bool
isAllValidForFeild values feild = all (\v -> isValidForFeild v feild) values

feildName :: Feild -> FeildName
feildName (Feild name _) = name

mappingFiled :: Document -> [[Feild]]
mappingFiled (feilds, _, tickets) = 
    reverse . foldl step [] $ (transpose tickets)
    where
        step :: [[Feild]] -> [Value] -> [[Feild]]
        step res values = (filter (isAllValidForFeild values) feilds) : res

isJust :: Maybe a -> Bool
isJust Nothing = False
isJust _ = True

choise :: [[Feild]] -> [Feild]
choise feildGroups = case doChoise feildGroups Set.empty of
    Just res -> res
    Nothing -> error "NO SUITABLE COMPONENT!"
    where
        doChoise :: [[Feild]] -> (Set.Set FeildName) -> Maybe [Feild]
        doChoise [] _ = Just []
        doChoise (feilds:rst) visited = 
            case noVisited of 
                [] -> Nothing
                fs -> case rstRes' of
                    [] -> Nothing
                    v -> head $ v
                    where
                        rstRes = map mappingFunction fs :: [Maybe [Feild]]
                        rstRes' = filter isJust $ zipWith zipFunction rstRes fs :: [Maybe [Feild]]

                        zipFunction :: Maybe [Feild] -> Feild -> Maybe [Feild]
                        zipFunction Nothing _ = Nothing
                        zipFunction (Just xs) x = Just (x:xs)

                        mappingFunction :: Feild -> Maybe [Feild]
                        mappingFunction feild = doChoise rst (Set.insert (feildName feild) visited)

            where
                noVisited = filter (not . (\n -> Set.member n visited) . feildName) feilds :: [Feild]

solute :: Document -> Value
solute document@(feilds, ticket, tickets) =
    product . map snd $ ticketWithDeparture
    where
        mappedFiled = choise . mappingFiled $ document
        filedTicket = zip (map feildName mappedFiled) ticket
        ticketWithDeparture = filter (\(name, _) -> isPrefixOf "departure" name) filedTicket

---------------------------------------------------------------------

main :: IO ()
main = do
    input <- readFile "input.txt"
    print . solute . filterInvalidValue . parseInput $ input